home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / CRS / crs06.d81 / months.sda / MAC (.txt) < prev    next >
Commodore BASIC  |  2009-10-10  |  9KB  |  305 lines
  1. 10 REM ********** M A C **********
  2. 12 REM MONTHLY APPOINTMENT CALENDAR
  3. 14 REM BY D. SCOTT, 2/89, PUBLIC DOMAIN
  4. 16 REM BASED ON CALENDAR PROGRAM BY
  5. 18 REM JOHN GORDON AND IAN MCLEAN
  6. 20 REM FROM 100 PROGRAMS FOR THE
  7. 22 REM COMMODORE 64
  8. 100 DIM C(7,6):DIM N$(19)
  9. 102 RESTORE
  10. 104 POKE53280,15:POKE53281,2:POKE646,15:POKE53272,21
  11. 106 PRINT"[147]                 M A C   [146][155]
  12. 108 [153]"  (null)USRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSR(null) "
  13. 110 [153]"  SGN                                  WAIT+ "
  14. 112 [153]"  SGN   CLOSE CLOSECLOSEMONTHLY APPOINTMENT        WAIT+ "
  15. 114 [153]"  SGN         C A L E N D A R          WAIT+ "
  16. 116 [153]"  SGN                                  WAIT+ "
  17. 118 [153]"  (null)ANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDANDSQR "
  18. 120 [153]"SYS   (1)LIST JAN  SYS(4) LISTAPR  SYS(7) LISTJUL  SYS(A) LISTOCT   ";
  19. 122 [153]"SYS   (2)LIST FEB  SYS(5) LISTMAY  SYS(8) LISTAUG  SYS(B) LISTNOV   ";
  20. 124 [153]"SYS   (3)LIST MAR  SYS(6) LISTJUN  SYS(9) LISTSEP  SYS(C) LISTDEC   ";
  21. 126 [153]"SYS    ^        ^        ^        ^        ";
  22. 128 [153]"    -LENLENLENLENLENLENLENLEN>LENLENLENLENLENLENLENLEN>LENLENLENLENLENLENLENLEN>LENLENLENLENLEN^  ";
  23. 130 [153]"    (null)     ENTER TO SELECT MONTH      (null)  ";
  24. 132 [153]"    /LENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENEXP  ";
  25. 134 [161]KEY$:[139]KEY$[178]""[167]134
  26. 136 [139]KEY$[178]"1"[167]M$[178]"JANUARY":[137]162
  27. 138 [139]KEY$[178]"2"[167]M$[178]"FEBRUARY":[137]162
  28. 140 [139]KEY$[178]"3"[167]M$[178]"MARCH":[137]162
  29. 142 [139]KEY$[178]"4"[167]M$[178]"APRIL":[137]162
  30. 144 [139]KEY$[178]"5"[167]M$[178]"MAY":[137]162
  31. 146 [139]KEY$[178]"6"[167]M$[178]"JUNE":[137]162
  32. 148 [139]KEY$[178]"7"[167]M$[178]"JULY":[137]162
  33. 150 [139]KEY$[178]"8"[167]M$[178]"AUGUST":[137]162
  34. 152 [139]KEY$[178]"9"[167]M$[178]"SEPTEMBER":[137]162
  35. 154 [139]KEY$[178]"A"[167]M$[178]"OCTOBER":[137]162
  36. 156 [139]KEY$[178]"B"[167]M$[178]"NOVEMBER":[137]162
  37. 158 [139]KEY$[178]"C"[167]M$[178]"DECEMBER":[137]162
  38. 160 [141]850:[137]134
  39. 162 [153]"LIST   MONTH SELECTED IS....SYS";M$
  40. 164 [133]"LIST   ENTER ENTIRE YEAR..SYS";Y
  41. 166 [153]"        CALCULATING - PLEASE WAIT       ";
  42. 168 D$[178]"    SUN  MON  TUE  WED  THU  FRI  SAT"
  43. 200 [143] *** CALENDAR CALCULATIONS
  44. 202 [143] *** GET NUMBER OF DAYS IN MONTH
  45. 204 M[178]0
  46. 206 [135]Q$,F,D
  47. 208 M[178]M[170]1
  48. 210 [139]M[178]13[167] [153]"INVALID MONTH":[137]102
  49. 212 [139][200](M$,3)[179][177][200](Q$,3)[167][137]206
  50. 214 [139]Y[177]1900[167]Y[178]Y[171]1900
  51. 216 L[178][181](Y[173]4)
  52. 218 OF[178]Y[170]L
  53. 222 [139]Y[171][181](Y[173]4)[172]4[178]0[175]M[179]3[167]OF[178]OF[171]1
  54. 224 [139]Y[171][181](Y[173]4)[172]4[178]0[175]M[178]2[167]D[178]29
  55. 226 OF[178]OF[171][181](OF[173]7)[172]7
  56. 228 F[178]F[170]OF
  57. 230 F[178]F[171][181](F[173]7)[172]7
  58. 232 [139]F[178]0[167]F[178]7
  59. 234 [129]I[178]1[164]F[171]1
  60. 236 C(I,1)[178]0
  61. 238 [130]I
  62. 240 DY[178]1
  63. 242 [129]I[178]F[164]7
  64. 244 C(I,1)[178]DY
  65. 246 DY[178]DY[170]1
  66. 248 [130]I
  67. 250 [129]J[178]2[164]6
  68. 252 [129]I[178]1[164]7
  69. 254 C(I,J)[178]DY
  70. 256 DY[178]DY[170]1
  71. 258 [139]DY[177]D[167]I[178]7:J[178]6
  72. 260 [130]I
  73. 262 [130]J
  74. 264 [137]300
  75. 280 [143] ERROR ROUTINE
  76. 285 [153]"LOAD          "E$:[141]850:[141]850:[141]850:[141]850:[141]800
  77. 290 [160]15:[160]2
  78. 300 [143]*****SCREEN PRINT OUT*****
  79. 302 [151]53280,15:[151]53281,2:[151]646,15
  80. 304 [153]"LOAD(null)USRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSRUSR(null)WAIT";
  81. 306 [153]"SGN  WAIT        M A I N    M E N U        WAITLIST  +WAIT";
  82. 308 [153]"SGN                                      +WAIT";
  83. 310 [153]"SGN  A = ANOTHER MONTH   M = MEMO OPTION +WAIT";
  84. 312 [153]"SGN  P = PRINT OPTION    Q = QUIT        +WAIT";
  85. 314 [153]"SGN                                      +WAIT";
  86. 316 [153]"SGN        PRESS KEY FOR SELECTION       +WAIT";
  87. 318 [139]Y[179]1800[167][153]"";M$;" ";Y[170]1900;"SYS"
  88. 320 [139]Y[177][178]1800[167][153]"";M$;" ";Y;"SYS"
  89. 322 [153]D$
  90. 324 [153]"  ORLENLENLENLEN=LENLENLENLEN=LENLENLENLEN=LENLENLENLEN=LENLENLENLEN=LENLENLENLEN=LENLENLENLEN^    ";
  91. 326 [129]J[178]1[164]6
  92. 328 [129]I[178]1[164]7
  93. 330 C$[178][196](C(I,J)):[139][195](C$)[178]2[167]C$[178]" "[170]C$
  94. 332 [139]C(I,J)[178]0[167][153]"(null)  ";"  ";
  95. 334 [139]C(I,J)[179][177]0[167][153]"(null)"C$;" ";
  96. 336 [139]I[178]7[167][153]"(null)";
  97. 338 [130]I
  98. 340 [153]""
  99. 342 [139]J[177]0[167][153]" ";
  100. 344 [139]J[178]6[167]350
  101. 346 [153]"ON -LENLENLENLEN(null)LENLENLENLEN(null)LENLENLENLEN(null)LENLENLENLEN(null)LENLENLENLEN(null)LENLENLENLEN(null)LENLENLENLEN<    ";
  102. 348 [130] J
  103. 350 [153]"ON /LENLENLENLEN>LENLENLENLEN>LENLENLENLEN>LENLENLENLEN>LENLENLENLEN>LENLENLENLEN>LENLENLENLENEXP   ";
  104. 352 [161]KEY$:[139]KEY$[178]""[167]352
  105. 354 [139]KEY$[178]"A"[167]P$[178]"MAC":[153]"":[137]900
  106. 356 [139]KEY$[178]"M"[167]364
  107. 358 [139]KEY$[178]"P"[167]600
  108. 360 [139]KEY$[178]"Q"[167][144]:P$[178]"         ":[137]900
  109. 361 [143] TO LOAD ANOTHER FILE ON EXIT, ENTER THAT NAME AS P$ IN LINE 360.
  110. 362 [141]800:[137]352
  111. 364 [153]"LOAD    ORLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLEN^"
  112. 366 [153]"    (null)                             WAIT(null)"
  113. 368 [153]"    (null)   M E M O   O P T I O N S   WAIT(null)"
  114. 370 [153]"    (null)                             WAIT(null)"
  115. 372 [153]"    (null) W = WRITE NEW MEMOS         WAIT(null)"
  116. 374 [153]"    (null) V = VIEW/EDIT CURRENT MEMOS WAIT(null)"
  117. 376 [153]"    (null) E = ESCAPE TO MENU          WAIT(null)"
  118. 378 [153]"    (null) ^                           WAIT(null)"
  119. 380 [153]"    (null) /LEN ENTER LETTER FOR CHOICE  WAIT(null)"
  120. 384 [153]"    (null)                             WAIT(null)"
  121. 386 [153]"    /LENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENLENEXP"
  122. 388 [161]KEY$:[139]KEY$[178]""[167]388
  123. 390 [139]KEY$[178]"W"[167]450
  124. 392 [139]KEY$[178]"V"[167]400
  125. 394 [139]KEY$[178]"E"[167]300
  126. 396 [141]800:[137]388
  127. 400 [143] ***** VIEW MEMOS *****
  128. 401 [159]15,8,15:[159]2,8,2,"MEMOS"[170]M$[170]",S,R"
  129. 402 [132]15,E,E$,E1,E2
  130. 404 [139]E[167]280
  131. 405 [129]L[178]0[164]19
  132. 406 [132]2,N$(L)
  133. 408 [130]L
  134. 410 [160]2
  135. 412 [153]"LOAD   MEMOS FOR ";M$"LIST"
  136. 414 [129]L[178]0[164]19
  137. 416 [153]"  "N$(L)
  138. 418 [130]L
  139. 420 [153]"         PRESS RETURN FOR CALENDAR"
  140. 422 [153]"         PRESS LETTER (E) FOR EDIT"
  141. 424 [161]KEY$:[139]KEY$[178]""[167]424
  142. 426 [139]KEY$[178][199](13)[167][160]15:[160]2:[137]300
  143. 428 [139]KEY$[178]"E"[167]432
  144. 430 [137]424
  145. 432 [153]"ONONONONONONONONONONONONONONONONONONONONONONONONONONON";
  146. 434 [153]" ORLENLENLENLEN ENTER NEW MEMO INFORMATION LENLENLENLEN^ WAIT";
  147. 436 [137]456
  148. 450 [143] ***** WRITE MEMOS *****
  149. 452 [153]"LOAD ORLENLENLENLENLENLEN ENTER MEMO INFORMATION LENLENLENLENLENLEN^ WAIT";
  150. 454 [153]" (null)                                    (null) WAIT";
  151. 456 [133]"";N$(0):[139]N$(0)[178]""[167]N$(0)[178]"-"
  152. 458 [133]"";N$(1):[139]N$(1)[178]""[167]N$(1)[178]"-"
  153. 460 [133]"";N$(2):[139]N$(2)[178]""[167]N$(2)[178]"-"
  154. 462 [133]"";N$(3):[139]N$(3)[178]""[167]N$(3)[178]"-"
  155. 464 [133]"";N$(4):[139]N$(4)[178]""[167]N$(4)[178]"-"
  156. 468 [133]"";N$(5):[139]N$(5)[178]""[167]N$(5)[178]"-"
  157. 470 [133]"";N$(6):[139]N$(6)[178]""[167]N$(6)[178]"-"
  158. 472 [133]"";N$(7):[139]N$(7)[178]""[167]N$(7)[178]"-"
  159. 474 [133]"";N$(8):[139]N$(8)[178]""[167]N$(8)[178]"-"
  160. 476 [133]"";N$(9):[139]N$(9)[178]""[167]N$(9)[178]"-"
  161. 478 [133]"";N$(10):[139]N$(10)[178]""[167]N$(10)[178]"-"
  162. 480 [133]"";N$(11):[139]N$(11)[178]""[167]N$(11)[178]"-"
  163. 482 [133]"";N$(12):[139]N$(12)[178]""[167]N$(12)[178]"-"
  164. 484 [133]"";N$(13):[139]N$(13)[178]""[167]N$(13)[178]"-"
  165. 486 [133]"";N$(14):[139]N$(14)[178]""[167]N$(14)[178]"-"
  166. 488 [133]"";N$(15):[139]N$(15)[178]""[167]N$(15)[178]"-"
  167. 490 [133]"";N$(16):[139]N$(16)[178]""[167]N$(16)[178]"-"
  168. 492 [133]"";N$(17):[139]N$(17)[178]""[167]N$(17)[178]"-"
  169. 494 [133]"";N$(18):[139]N$(18)[178]""[167]N$(18)[178]"-"
  170. 496 [133]"";N$(19):[139]N$(19)[178]""[167]N$(19)[178]"-"
  171. 498 [153]"       IS THIS CORRECT (Y/N)?
  172. 500 GETKEY$:IFKEY$=""THEN500
  173. 502 IFKEY$="Y"THEN550
  174. 504 IFKEY$="N"THEN508
  175. 506 GOTO500
  176. 508 PRINT"[145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145][145]";
  177. 510 PRINT" [176][195][195][195][195][195] REENTER MEMO INFORMATION [195][195][195][195][195][174] [158][146]";
  178. 512 GOTO456
  179. 550 REM *****SAVE MONTHLY MEMOS*****
  180. 552 PRINT"[145]          SAVING MEMO INFORMATION  [146][155]"
  181. 554 OPEN2,8,2,"@:MEMOS"+M$+",S,W"
  182. 556 FORL=0TO19
  183. 558 PRINT#2,N$(L)
  184. 560 NEXTL
  185. 562 CLOSE2:CLOSE15
  186. 564 PRINT"         PRESS RETURN FOR CALENDAR "
  187. 566 GETKEY$:IFKEY$=""THEN568
  188. 568 FORR=1TO100:NEXTR
  189. 570 PRINT"[145]         PRESS RETURN FOR CALENDAR [146][155]"
  190. 572 IFKEY$=CHR$(13)THEN300
  191. 574 GETKEY$:IFKEY$=""THEN576
  192. 576 FORR=1TO100:NEXTR
  193. 578 PRINT"[145]         PRESS RETURN FOR CALENDAR "
  194. 580 IFKEY$=CHR$(13)THEN300
  195. 582 GOTO566
  196. 600 REM ***** PRINT OPTIONS
  197. 602 POKE53281,6:GOSUB800:GOSUB800
  198. 604 PRINT"[147]  [155][176][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][174]"
  199. 606 PRINT"  [221][158]                                  [146][155][221]"
  200. 608 PRINT"  [221][158]     PRINTER MUST BE ONLINE       [146][155][221]"
  201. 610 PRINT"  [221][158]                                  [146][155][221]"
  202. 612 PRINT"  [221][159]                                  [146][155][221]"
  203. 614 PRINT"  [221][159]      P = PRINT CALENDAR & MEMOS  [146][155][221]"
  204. 616 PRINT"  [221][159]                                  [146][155][221]"
  205. 618 PRINT"  [221][159]      E = ESCAPE TO MENU          [146][155][221]"
  206. 620 PRINT"  [221][159]      ^                           [146][155][221]"
  207. 622 PRINT"  [221][159]      [221]                           [146][155][221]"
  208. 624 PRINT"  [221][159]    ENTER LETTER FOR CHOICE       [146][155][221]"
  209. 626 PRINT"  [221][159]                                  [146][155][221]"
  210. 628 PRINT"  [155][173][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][195][189]"
  211. 630 GETKEY$:IFKEY$=""THEN630
  212. 632 IFKEY$="E"THEN300
  213. 634 IFKEY$="P"THENGOSUB950:GOTO638
  214. 636 GOTO630
  215. 638 PRINT"[147]":OPEN4,4:CMD4
  216. 640 IFY<1800THENY=Y+1900
  217. 642 PRINT#4,CHR$(14)
  218. 644 PRINT#4,M$;" ";Y
  219. 646 PRINT#4,CHR$(15)
  220. 648 PRINT#4:PRINT#4:PRINT#4,"   SUNDAY     MONDAY    TUESDAY    WEDNESDAY";
  221. 650 PRINT#4, "   THURSDAY    FRIDAY    SATURDAY "
  222. 651 PRINT#4,"[213][195][195][195][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][178]";
  223. 652 PRINT#4,"[195][195][195][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][178][195][195][195][195][195][195][195][195][195][195][201]"
  224. 654 FORJ=1TO6
  225. 656 FORI=1TO7
  226. 658 C$=STR$(C(I,J)):IFLEN(C$)=2THENC$=" "+C$
  227. 660 IFC(I,J)=0THENPRINT#4,"[221]      ";"    ";
  228. 662 IFC(I,J)<>0THENPRINT#4,"[221]      "C$;" ";
  229. 664 IFI=7THENPRINT#4,"[221]"
  230. 666 NEXTI
  231. 668 PRINT#4,"[221]          [221]          [221]          [221]          [221]";
  232. 670 PRINT#4,"          [221]          [221]          [221]"
  233. 672 PRINT#4,"[221]          [221]          [221]          [221]          [221]";
  234. 674 PRINT#4,"          [221]          [221]          [221]"
  235. 676 PRINT#4,"[221]          [221]          [221]          [221]          [221]";
  236. 678 PRINT#4,"          [221]          [221]          [221]"
  237. 682 PRINT#4,"[221]          [221]          [221]          [221]          [221]";
  238. 684 PRINT#4,"          [221]          [221]          [221]"
  239. 686 IFJ>0THENPRINT#4,"";
  240. 688 IFJ=6THEN696
  241. 690 PRINT#4,"[171][195][195][195][195][195][195][195][195][195][195][219][195][195][195][195][195][195][195][195][195][195][219][195][195][195][195][195][195][195][195][195][195][219][195][195][195][195][195][195][195][195][195][195][219]";
  242. 692 PRINT#4,"[195][195][195][195][195][195][195][195][195][195][219][195][195][195][195][195][195][195][195][195][195][219][195][195][195][195][195][195][195][195][195][195][179]"
  243. 694 NEXT J
  244. 696 PRINT#4,"[202][195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][177]";
  245. 698 PRINT#4,"[195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][177][195][195][195][195][195][195][195][195][195][195][203]"
  246. 700 PRINT#4,CHR$(14)
  247. 702 PRINT#4,"               M E M O S    "
  248. 704 PRINT#4,CHR$(15)
  249. 706 OPEN15,8,15:OPEN2,8,2,"MEMOS"+M$+",S,R"
  250. 708 INPUT#15,E,E$,E1,E2
  251. 710 IFETHENCLOSE4:GOTO280
  252. 712 FORL=0TO19
  253. 714 INPUT#2,N$(L)
  254. 716 NEXTL
  255. 718 CLOSE2
  256. 730 PRINT#4,N$(0);"  ";
  257. 732 PRINT#4,N$(1)
  258. 734 PRINT#4,N$(2);"  ";
  259. 736 PRINT#4,N$(3)
  260. 738 PRINT#4,N$(4);"  ";
  261. 740 PRINT#4,N$(5)
  262. 742 PRINT#4,N$(6);"  ";
  263. 744 PRINT#4,N$(7)
  264. 746 PRINT#4,N$(8);"  ";
  265. 748 PRINT#4,N$(9)
  266. 750 PRINT#4,N$(10);"  ";
  267. 752 PRINT#4,N$(11)
  268. 754 PRINT#4,N$(12);"  ";
  269. 756 PRINT#4,N$(13)
  270. 758 PRINT#4,N$(14);"  ";
  271. 760 PRINT#4,N$(15)
  272. 762 PRINT#4,N$(16);"  ";
  273. 764 PRINT#4,N$(17)
  274. 766 PRINT#4,N$(18);"  ";
  275. 768 PRINT#4,N$(19)
  276. 770 CLOSE4,4:GOTO300
  277. 800 REM   WARNING TONE ROUTINES
  278. 805 REM          BELL
  279. 810 POKE54296,15:POKE54277,16:POKE54278,247
  280. 815 POKE54276,17:POKE54273,25:POKE54272,10
  281. 820 FORWT=1TO300:NEXT:POKE54276,0:RETURN
  282. 850 REM          BUZZER
  283. 855 POKE54296,15:POKE54277,45:POKE54278,165
  284. 860 POKE54276,33:POKE54273,6:POKE54272,5
  285. 865 FORWT=1TO150:NEXT:POKE54276,16:RETURN
  286. 900 PRINT"[147]LOAD"CHR$(34)P$CHR$(34)",8"
  287. 905 PRINT"RUN"
  288. 910 POKE198,3:POKE631,19:POKE632,13:POKE633,13
  289. 915 NEW
  290. 920 END
  291. 950 REM CHECK FOR PRINTER ROUTINE
  292. 952 OPEN4,4:PRINT#4,CHR$(0)
  293. 954 IFST=0THENCLOSE4:RETURN
  294. 956 PRINT"[144]  PRINTER NOT ON LINE !!!":CLOSE4:GOSUB850
  295. 958 PRINT"  PRESS [ + ] TO TRY AGAIN"
  296. 960 PRINT"  PRESS [ _ ] TO ESCAPE PRINT"
  297. 962 GETKEY$:IFKEY$=""THEN962
  298. 964 IFKEY$=CHR$(43)THENPRINT"[145][145][145][145]":GOTO950
  299. 966 IFKEY$=CHR$(95)THEN300
  300. 968 GOTO962
  301. 1000 DATA JANUARY,2,31,FEBRUARY,5,28,MARCH,5,31,APRIL,1,30,MAY,3,31,JUNE,6,30
  302. 1010 DATA JULY,1,31,AUGUST,4,31,SEPTEMBER,7,30,OCTOBER,2,31
  303. 1020 DATA NOVEMBER,5,30,DECEMBER,7,31
  304. 1030 DATA ,,
  305.